home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-01-03 | 24.6 KB | 848 lines | [TEXT/MPS ] |
- {===========================================================}
- { }
- { Server Control Snippets }
- { The server control code snippets found in the }
- { AppleShare 3.0 Developer's Kit Server Control and Server }
- { Event Handling document. }
- { }
- { by J. Luther, Apple Developer Technical Support }
- { Copyright Apple Computer, Inc. 1992-1994 }
- { All rights reserved }
- { }
- { Updated for File Sharing 4.0 - 9/8/1994 JML }
- { }
- { Here's the deal with the code in this file. }
- { }
- { For each server control call, there is a function named }
- { MySCxxxx. The typical MySCxxxx function shows how to }
- { fill in the parameter block, make the server control }
- { call, and return any result values the server control }
- { returns. In addition, I've made every attempt to make }
- { the server control calls supported by Macintosh File }
- { Sharing act like the same server control calls under }
- { AppleShare 3.0. In some cases, that means I've filled }
- { in the return values not supplied by Macintosh File }
- { Sharing. In other cases (i.e., SCGetExpFldr), I've had }
- { to add code just to make the server control call work as }
- { advertised. }
- { }
- { For some server control calls, I've added another code }
- { snippet, procedure, or function to show a common use of }
- { that particular server control call. Here's what you'll }
- { find: }
- { }
- { • There are code snippets that get the server version, }
- { status, and setup information and then store that }
- { information in global variables for later use by other }
- { functions. In some case, other code depends on those }
- { global variables being initialized and that is noted }
- { where applicable. }
- { }
- { • There are functions and procedures that show how to }
- { enumerate the list of exported volumes and folder, }
- { enumerate the list of installed server event handlers, }
- { enumerate the list of connected users, get a users mount }
- { information for all volumes or folders mounted, }
- { disconnect a user from the server, send a message to all }
- { connected users, and disconnect the users of a specified }
- { volume. }
- { }
- { All the test functions and snippets are marked like }
- { this: ••• Test Code ••• }
- { Some code snippets are commented out under the Test Code }
- { markers, because they won't compile there. They can be }
- { found again between the main BEGIN and END. }
- { }
- {===========================================================}
-
- PROGRAM SC_Snippets;
-
- USES
- Traps, AppleTalk, Errors, Memory, ServerEventIntf, ServerControlIntf;
-
- { File Sharing 4.0 supports most server control calls just like AppleShare. }
- { The only exceptions are SCShutDown and SCDisconnect which ignore the }
- { flags and messagePtr parameters because those calls were supported by }
- { the old File Sharing code and some callers didn't bother to set }
- { messagePtr to NULL. }
-
- CONST
- kNewFileSharingVersion = $3e; { File Sharing 4.0's version number }
-
- TYPE
- Str13 = STRING[13];
-
- VAR
- gErr: OSErr;
- gHasServerDispatch: Boolean;
-
- { results from SCServerVersion }
- gServerExtensionName: Str31;
- gServerType: Integer;
- gServerVersion: Integer;
-
- { results from SCPollServer }
- gServerState: Integer;
- gDisconnectState: Integer;
- gServerError: Integer;
- gSecondsLeft: LongInt;
-
- { results from SCGetSetupInfo }
- gSetupInfoRec: SetupInfoRec;
- gMaxVolumes: Integer;
- gMaxExpFolders: Integer;
- gCurMaxSessions: Integer;
-
- {=======================================================================================}
- { the following three functions (NumToolboxTraps, GetTrapType, and TrapAvailable) }
- { are from Inside Macintosh Volume VI. }
-
- FUNCTION NumToolboxTraps: Integer;
- BEGIN
- IF NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) THEN
- NumToolboxTraps := $200
- ELSE
- NumToolboxTraps := $400;
- END;
-
- {------------------------------------------------------------------------------------}
-
- FUNCTION GetTrapType (theTrap: Integer): TrapType;
- CONST
- TrapMask = $0800;
- BEGIN
- IF BAND(theTrap, TrapMask) > 0 THEN
- GetTrapType := ToolTrap
- ELSE
- GetTrapType := OSTrap;
- END;
-
- {------------------------------------------------------------------------------------}
-
- FUNCTION TrapAvailable (theTrap: Integer): Boolean;
- VAR
- tType: TrapType;
- BEGIN
- tType := GetTrapType(theTrap);
- IF tType = ToolTrap THEN
- BEGIN
- theTrap := BAND(theTrap, $07FF);
- IF theTrap >= NumToolboxTraps THEN
- theTrap := _Unimplemented;
- END;
- TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap)
- END;
-
- {=======================================================================================}
-
- {-----------------------------------------------------------}
- { This function calls SCServerVersion to get the file }
- { server extension's name and the server's type and }
- { version. }
- { Note: The server version (scServerVersion) returned by }
- { Macintosh File Sharing servers is not valid when }
- { the file server is not running. }
-
- FUNCTION MySCServerVersion (ExtNamePtr: StringPtr;
- VAR ServerType: Integer;
- VAR ServerVersion: Integer): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.versionPB.scCode := SCServerVersion;
- scPB.versionPB.scExtNamePtr := ExtNamePtr;
-
- MySCServerVersion := SyncServerDispatch(@scPB);
-
- ServerType := scPB.versionPB.scServerType;
- ServerVersion := scPB.versionPB.scServerVersion;
- END;
-
- {••• Test Code •••}
- { Get the server version information and store it in }
- { global variables for user later }
-
- (* err := MySCServerVersion(@gServerExtensionName, gServerType, gServerVersion); *)
-
-
- {-----------------------------------------------------------}
- { This function calls SCPollServer to find out what the }
- { server is doing. }
-
- FUNCTION MySCPollServer (VAR ServerState: Integer;
- VAR DisconnectState: Integer;
- VAR ServerError: Integer;
- VAR SecondsLeft: LongInt): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.pollServerPB.scCode := SCPollServer;
- { Macintosh File Sharing doesn't return scSecondsLeft so zero it. }
- scPB.pollServerPB.scSecondsLeft := 0;
-
- MySCPollServer := SyncServerDispatch(@scPB);
-
- ServerState := scPB.pollServerPB.scServerState;
- DisconnectState := scPB.pollServerPB.scDisconnectState;
- ServerError := scPB.pollServerPB.scServerError;
- SecondsLeft := scPB.pollServerPB.scSecondsLeft;
- END;
-
- {••• Test Code •••}
- { Find out what the server's doing and store it in }
- { global variables for user later }
-
- (* err := MySCPollServer(gServerState, gDisconnectState, gServerError, gSecondsLeft); *)
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetSetupInfo to get the file }
- { server's setup information. If the server type is a }
- { Macintosh File Sharing server, then this function fills }
- { in the fields that aren't returned by the server control }
- { call. This function depends on gServerType and }
- { gServerVersion being initialized with SCServerVersion. }
-
- FUNCTION MySCGetSetupInfo (SetupPtr: SetupInfoRecPtr;
- VAR MaxVolumes: Integer;
- VAR MaxExpFolders: Integer;
- VAR CurMaxSessions: Integer): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.setupPB.scCode := SCGetSetupInfo;
- scPB.setupPB.scSetupPtr := SetupPtr;
-
- MySCGetSetupInfo := SyncServerDispatch(@scPB);
-
- IF (gServerType = MFSType) AND (gServerVersion < kNewFileSharingVersion) THEN
- BEGIN
- MaxVolumes := 10;
- MaxExpFolders := 10;
- CurMaxSessions := SetupPtr^.SIMaxLogins;
- END
- ELSE
- BEGIN
- MaxVolumes := scPB.setupPB.scMaxVolumes;
- MaxExpFolders := scPB.setupPB.scMaxExpFolders;
- CurMaxSessions := scPB.setupPB.scCurMaxSessions;
- END;
- END;
-
- {••• Test Code •••}
- { Get the server's setup information and store it in }
- { global variables for user later }
-
- (* err := MySCGetSetupInfo(@gSetupInfoRec, gMaxVolumes, gMaxExpFolders, gCurMaxSessions); *)
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetExpFldr to get the export }
- { information for shared volumes and folders at the index }
- { position specified. This function depends on gServerType }
- { being initialized with SCServerVersion. }
-
- FUNCTION MySCGetExpFldr (NamePtr: StringPtr;
- VAR VRefNum: Integer;
- VAR Logins: Integer;
- Index: Integer;
- VAR DirID: LongInt): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.standardPB.scCode := SCGetExpFldr;
- { Initialize scVRefNum to 0 so we can tell if }
- { SCGetExpFldr returned something when used with }
- { Macintosh File Sharing }
- scPB.standardPB.scVRefNum := 0;
- IF Index < 0 THEN
- BEGIN
- { File Sharing trashes memory if (scIndex < 0) and }
- { (scNamePtr <> NIL), so we'll prevent that from }
- { happening here. }
- scPB.standardPB.scNamePtr := NIL;
- { and we'll return an empty string }
- IF NamePtr <> NIL THEN
- NamePtr^ := '';
- END
- ELSE
- BEGIN
- scPB.standardPB.scNamePtr := NamePtr;
- END;
- scPB.standardPB.scIndex := Index;
-
- MySCGetExpFldr := SyncServerDispatch(@scPB);
-
- IF (gServerType = MFSType) AND (gServerVersion < kNewFileSharingVersion) THEN
- BEGIN
- IF scPB.standardPB.scVRefNum <> 0 THEN
- BEGIN
- VRefNum := scPB.standardPB.scVRefNum;
- Logins := 0;
- DirID := scPB.standardPB.scDirID;
- END
- ELSE { there's nothing at this index position }
- { so force the error code to make it act }
- { like AppleShare }
- MySCGetExpFldr := fnfErr;
- END
- ELSE
- BEGIN
- VRefNum := scPB.standardPB.scVRefNum;
- Logins := scPB.standardPB.scLogins;
- DirID := scPB.standardPB.scDirID;
- END;
- END;
-
- {••• Test Code •••}
- { Enumerate the list of exported volumes and folders }
-
- PROCEDURE GetAllExpFldrs;
- VAR
- Index: Integer;
- shortName: Str13;
- VRefNum: Integer;
- Logins: Integer;
- DirID: LongInt;
- err: OSErr;
- BEGIN
- FOR Index := -gMaxVolumes TO gMaxExpFolders DO
- IF Index <> 0 THEN { index 0 is undefined }
- BEGIN
- err := MySCGetExpFldr(@shortName, VRefNum, Logins, Index, DirID);
- IF err = noErr THEN
- BEGIN
- IF Index < 0 THEN
- BEGIN
- { do something with the exported volume }
- { information }
- END
- ELSE
- BEGIN
- { do something with the exported folder }
- { information }
- END;
- END
- ELSE IF err <> fnfErr THEN
- { fnfErr only means there is nothing at this }
- { Index position }
- BEGIN
- { handle any unexpected errors }
- END;
- END;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetServerStatus to get the file }
- { server's current status information. }
-
- FUNCTION MySCGetServerStatus (NamePtr: StringPtr;
- VAR ServerFlags: Integer;
- VAR NumSessions: Integer;
- VAR UserListModDate: LongInt;
- VAR Activity: Integer;
- VAR VolListModDate: LongInt): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.statusPB.scCode := SCGetServerStatus;
- scPB.statusPB.scNamePtr := NamePtr;
-
- MySCGetServerStatus := SyncServerDispatch(@scPB);
-
- ServerFlags := scPB.statusPB.scServerFlags;
- NumSessions := scPB.statusPB.scNumSessions;
- UserListModDate := scPB.statusPB.scUserListModDate;
- Activity := scPB.statusPB.scActivity;
- VolListModDate := scPB.statusPB.scVolListModDate;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetServerEventProc to get a }
- { pointer to the head of the server event handler queue. }
-
- FUNCTION MySCGetServerEventProc (VAR theSEQHdrPtr: QHdrPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.serverEventPB.scCode := SCGetServerEventProc;
-
- MySCGetServerEventProc := SyncServerDispatch(@scPB);
-
- theSEQHdrPtr := QHdrPtr(scPB.serverEventPB.scSEQEntryPtr);
- END;
-
- {••• Test Code •••}
- { Enumerate the list of installed server event handlers. }
-
- PROCEDURE GetServerEventHandlers;
- VAR
- err: OSErr;
- theSEQHdrPtr: QHdrPtr;
- theSEQEntryPtr: tSEQEntryPtr;
-
- BEGIN
- err := MySCGetServerEventProc(theSEQHdrPtr);
- IF err = noErr THEN
- BEGIN
- theSEQEntryPtr := tSEQEntryPtr(theSEQHdrPtr^.qHead);
- WHILE theSEQEntryPtr <> NIL DO
- BEGIN
- { do something with the tSEQentry pointed to }
- { by theSEQEntryPtr }
-
- { move pointer to next entry (if any) }
- theSEQEntryPtr := tSEQEntryPtr(theSEQEntryPtr^.SEQentry.qLink);
- END;
- END
- ELSE
- BEGIN
- { handle any errors }
- END;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetUserNameRec to retrieve }
- { statistics on a connected user. }
-
- FUNCTION MySCGetUserNameRec (NamePtr: StringPtr;
- VAR Position: LongInt;
- VAR UNRecID: LongInt;
- VAR UserID: LongInt;
- VAR LoginTime: LongInt;
- VAR LastUseTime: LongInt;
- VAR SocketNum: AddrBlock): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.userInfoPB.scCode := SCGetUserNameRec;
- scPB.userInfoPB.scNamePtr := NamePtr;
- scPB.userInfoPB.scPosition := Position;
-
- MySCGetUserNameRec := SyncServerDispatch(@scPB);
-
- Position := scPB.userInfoPB.scPosition;
- UNRecID := scPB.userInfoPB.scUNRecID;
- UserID := scPB.userInfoPB.scUserID;
- LoginTime := scPB.userInfoPB.scLoginTime;
- LastUseTime := scPB.userInfoPB.scLastUseTime;
- SocketNum := scPB.userInfoPB.scSocketNum;
- END;
-
- {••• Test Code •••}
- { Enumerate the list of users logged on }
-
- PROCEDURE GetAllUserNameRecs;
- VAR
- err: OSErr;
- UserName: Str31;
- Position: LongInt;
- UNRecID: LongInt;
- UserID: LongInt;
- LoginTime: LongInt;
- LastUseTime: LongInt;
- SocketNum: AddrBlock;
- BEGIN
- Position := 0;
- REPEAT
- err := MySCGetUserNameRec(@UserName, Position, UNRecID, UserID, LoginTime, LastUseTime, SocketNum);
- IF err = noErr THEN
- BEGIN
- { do something with the user information returned }
- END
- ELSE IF err <> fnfErr THEN
- { fnfErr only means there are no more users }
- BEGIN
- { handle any unexpected errors }
- END;
- UNTIL err <> noErr;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCGetUserMountInfo to return }
- { information telling how a user is using a particular }
- { volume or exported folder. }
-
- FUNCTION MySCGetUserMountInfo (VRefNum: Integer;
- VAR FilesOpen: Integer;
- VAR WriteableFiles: Integer;
- UNRecID: LongInt;
- VAR Mounted: Boolean;
- VAR MountedAsOwner: Boolean): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.volMountedPB.scCode := SCGetUserMountInfo;
- scPB.volMountedPB.scVRefNum := VRefNum;
- scPB.volMountedPB.scUNRecID := UNRecID;
-
- MySCGetUserMountInfo := SyncServerDispatch(@scPB);
-
- FilesOpen := scPB.volMountedPB.scFilesOpen;
- WriteableFiles := scPB.volMountedPB.scWriteableFiles;
- Mounted := scPB.volMountedPB.scMounted;
- MountedAsOwner := scPB.volMountedPB.scMountedAsOwner;
- END;
-
- {••• Test Code •••}
- { Get the user mount information for all volumes and }
- { exported folders a user has mounted. }
-
- PROCEDURE GetAllUserMountInfo (UNRecID: LongInt);
- VAR
- err: OSErr;
- Index: Integer;
- VRefNum: Integer;
- FilesOpen: Integer;
- WriteableFiles: Integer;
- Mounted: Boolean;
- MountedAsOwner: Boolean;
- BEGIN
- FOR Index := -gMaxVolumes TO gMaxExpFolders DO
- IF Index <> 0 THEN { index 0 is undefined }
- BEGIN
- err := MySCGetUserMountInfo(Index, FilesOpen, WriteableFiles, UNRecID, Mounted, MountedAsOwner);
- IF (err = noErr) AND Mounted THEN
- BEGIN
- { do something with the information returned }
- END;
- END;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCStartServer to start the Macintosh }
- { File Sharing server. }
-
- FUNCTION MySCStartServer: OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.startPB.scCode := SCStartServer;
- scPB.startPB.scStartSelect := kCurInstalled;
- scPB.startPB.scEventSelect := kFinderExtn;
-
- MySCStartServer := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCShutDown to shut down the file }
- { server. }
-
- FUNCTION MySCShutDown (NumMinutes: Integer;
- Flags: Integer;
- MessagePtr: StringPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scCode := SCShutDown;
- scPB.disconnectPB.scNumMinutes := NumMinutes;
- scPB.disconnectPB.scFlags := Flags;
- scPB.disconnectPB.scMessagePtr := MessagePtr;
-
- MySCShutDown := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCCancelShutDown to cancel the }
- { shutdown or disconnect in progress. }
-
- FUNCTION MySCCancelShutDown: OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scCode := SCCancelShutDown;
-
- MySCCancelShutDown := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCWakeServer to wake up a sleeping }
- { AppleShare 3.0 file server. }
-
- FUNCTION MySCWakeServer: OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.startPB.scCode := SCWakeServer;
-
- MySCWakeServer := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCSleepServer to shut down the file }
- { server temporarily. }
-
- FUNCTION MySCSleepServer (NumMinutes: Integer;
- Flags: Integer;
- MessagePtr: StringPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scCode := SCSleepServer;
- scPB.disconnectPB.scNumMinutes := NumMinutes;
- scPB.disconnectPB.scFlags := Flags;
- scPB.disconnectPB.scMessagePtr := MessagePtr;
-
- MySCSleepServer := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCSetSetupInfo to set the file }
- { server's setup information. }
-
- FUNCTION MySCSetSetupInfo (SetupPtr: SetupInfoRecPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.setupPB.scCode := SCSetSetupInfo;
- scPB.setupPB.scSetupPtr := SetupPtr;
-
- MySCSetSetupInfo := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCDisconnect to disconnect some }
- { users. Although Macintosh File Sharing implements }
- { SCDisconnect, there is no way to use it with File }
- { Sharing because File Sharing doesn't implement the }
- { SCGetUserNameRec call. }
-
- FUNCTION MySCDisconnect (DiscArrayPtr: LongIntPtr;
- ArrayCount: Integer;
- NumMinutes: Integer;
- Flags: Integer;
- MessagePtr: StringPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scDiscArrayPtr := DiscArrayPtr;
- scPB.disconnectPB.scArrayCount := ArrayCount;
- scPB.disconnectPB.scCode := SCDisconnect;
- scPB.disconnectPB.scNumMinutes := NumMinutes;
- scPB.disconnectPB.scFlags := Flags;
- scPB.disconnectPB.scMessagePtr := MessagePtr;
-
- MySCDisconnect := SyncServerDispatch(@scPB);
- END;
-
- {••• Test Code •••}
- { Disconnect the user specified in 10 minutes with a }
- { message. }
-
- PROCEDURE DisconnectUser (UNRecID: LongInt);
- VAR
- err: OSErr;
- ArrayCount: Integer;
- NumMinutes: Integer;
- Flags: Integer;
- Message: tLoginMsg;
- BEGIN
- ArrayCount := 1; { one user }
- NumMinutes := 10;
- Flags := UNRFSendMsgMask; { send a message }
- Message := 'Goodbye.';
- err := MySCDisconnect(@UNRecID, ArrayCount, NumMinutes, Flags, @Message);
- IF err = noErr THEN
- { the disconnect was started }
- ELSE
- BEGIN
- { handle any errors }
- END;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCSendMessage to send a message to }
- { some users. }
-
- FUNCTION MySCSendMessage (DiscArrayPtr: LongIntPtr;
- ArrayCount: Integer;
- Flags: Integer;
- MessagePtr: StringPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scDiscArrayPtr := DiscArrayPtr;
- scPB.disconnectPB.scArrayCount := ArrayCount;
- scPB.disconnectPB.scCode := SCSendMessage;
- scPB.disconnectPB.scFlags := Flags;
- scPB.disconnectPB.scMessagePtr := MessagePtr;
-
- MySCSendMessage := SyncServerDispatch(@scPB);
- END;
-
- {••• Test Code •••}
- { Send a message to all connected users }
-
- PROCEDURE SendMessageToAll;
- { This routine depends on gCurMaxSessions being }
- { initialized with SCGetSetupInfo. }
- VAR
- err: OSErr;
- ArrayPosPtr: LongIntPtr;
- scPB: SCParamBlockRec;
-
- DiscArrayPtr: LongIntPtr;
- ArrayCount: Integer;
- Flags: Integer;
- Message: tLoginMsg;
- BEGIN
- { allocate an array large enough to get all users }
- DiscArrayPtr := LongIntPtr(NewPtr(sizeof(LongInt) * gCurMaxSessions));
- IF DiscArrayPtr <> NIL THEN
- BEGIN
- scPB.userInfoPB.scPosition := 0;
- ArrayCount := 0;
- ArrayPosPtr := DiscArrayPtr;
- REPEAT
- { build list of users with SCGEtUserNameRec }
- scPB.userInfoPB.scCode := SCGetUserNameRec;
- scPB.userInfoPB.scNamePtr := NIL;
- err := SyncServerDispatch(@scPB);
- IF err = noErr THEN
- BEGIN { add user to array }
- ArrayPosPtr^ := scPB.userInfoPB.scUNRecID;
- ArrayPosPtr := LongIntPtr(ORD4(ArrayPosPtr) + sizeof(LongInt));
- ArrayCount := ArrayCount + 1;
- END;
- UNTIL err <> noErr;
- IF ArrayCount > 0 THEN
- BEGIN
- Flags := UNRFSendMsgMask; { send a message }
- Message := 'Moof!t';
- err := MySCSendMessage(DiscArrayPtr, ArrayCount, Flags, @Message);
- IF err = noErr THEN
- { the message was sent }
- ELSE
- BEGIN
- { handle any errors from SCSendMessage }
- END
- END
- ELSE { there are no users connected }
- ; { do nothing }
- DisposPtr(Ptr(DiscArrayPtr));
- END
- ELSE
- BEGIN
- { handle memory manager error }
- END;
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCSetCopyProtect to set the copy }
- { protect status of a file. }
-
- FUNCTION MySCSetCopyProtect (NamePtr: StringPtr;
- VRefNum: Integer;
- DirID: LongInt): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.standardPB.scNamePtr := NamePtr;
- scPB.standardPB.scVRefNum := VRefNum;
- scPB.standardPB.scCode := SCSetCopyProtect;
- scPB.standardPB.scDirID := DirID;
-
- MySCSetCopyProtect := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCClrCopyProtect to clear the copy }
- { protect status of a file. }
-
- FUNCTION MySCClrCopyProtect (NamePtr: StringPtr;
- VRefNum: Integer;
- DirID: LongInt): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.standardPB.scNamePtr := NamePtr;
- scPB.standardPB.scVRefNum := VRefNum;
- scPB.standardPB.scCode := SCClrCopyProtect;
- scPB.standardPB.scDirID := DirID;
-
- MySCClrCopyProtect := SyncServerDispatch(@scPB);
- END;
-
-
- {-----------------------------------------------------------}
- { This function calls SCDisconnectVolUsers to disconnect }
- { the users of specified volumes. }
-
- FUNCTION MySCDisconnectVolUsers (DiscArrayPtr: LongIntPtr;
- ArrayCount: Integer;
- NumMinutes: Integer;
- Flags: Integer;
- MessagePtr: StringPtr): OSErr;
- VAR
- scPB: SCParamBlockRec;
- BEGIN
- scPB.disconnectPB.scDiscArrayPtr := DiscArrayPtr;
- scPB.disconnectPB.scArrayCount := ArrayCount;
- scPB.disconnectPB.scCode := SCDisconnectVolUsers;
- scPB.disconnectPB.scNumMinutes := NumMinutes;
- scPB.disconnectPB.scFlags := Flags;
- scPB.disconnectPB.scMessagePtr := MessagePtr;
-
- MySCDisconnectVolUsers := SyncServerDispatch(@scPB);
- END;
-
- {••• Test Code •••}
- { Disconnect the users of the specified volume in }
- { 10 minutes with a message. }
-
- PROCEDURE DisconnectVolUsers (VRefNum: Integer);
- VAR
- err: OSErr;
-
- DiscToDisconnect: LongInt;
- ArrayCount: Integer;
- NumMinutes: Integer;
- Flags: Integer;
- Message: tLoginMsg;
- BEGIN
- DiscToDisconnect := VRefNum; { note: Integer -> LongInt }
- ArrayCount := 1;
- NumMinutes := 10;
- Flags := UNRFSendMsgMask; { send a message }
- Message := 'A volume is going away.';
- err := MySCDisconnectVolUsers(@DiscToDisconnect, ArrayCount, NumMinutes, Flags, @Message);
- IF err = noErr THEN
- { the disconnect was started }
- ELSE
- BEGIN
- { handle any errors }
- END;
- END;
-
-
- {==========================================================}
-
- BEGIN { main }
-
- { You MUST make sure ServerDispatch is available before calling it }
- gHasServerDispatch := TrapAvailable(ServerDispatch);
- IF gHasServerDispatch THEN
- BEGIN
-
- gErr := MySCServerVersion(@gServerExtensionName, gServerType, gServerVersion);
-
- gErr := MySCPollServer(gServerState, gDisconnectState, gServerError, gSecondsLeft);
-
- gErr := MySCGetSetupInfo(@gSetupInfoRec, gMaxVolumes, gMaxExpFolders, gCurMaxSessions);
- END;
-
- END. { main }